home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / intrfc61.arc / SRCFILES.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-28  |  4KB  |  150 lines
  1. unit srcfiles;
  2.  
  3. interface
  4.  
  5. uses dos,globals,util,dump,loader,head;
  6.  
  7. type
  8.   src_file_ptr = ^src_file_rec;
  9.   src_file_rec = record
  10.     filetype : byte;
  11.     w1 : word;
  12.     packed_date : longint;
  13.     filename : string;
  14.   end;
  15.  
  16.   src_line_ptr = ^src_line_rec;
  17.   src_line_rec = record
  18.     owner_ofs,
  19.     src_ofs,
  20.     entry,startline,numlines : word;
  21.   end;
  22.  
  23. procedure print_src_files;
  24. procedure print_src_lines;
  25.  
  26. implementation
  27.  
  28. function tf(w:word):string;  { Time format of a number }
  29. var
  30.   result : string[3];   { Use length 3 in to show errors }
  31. begin
  32.   str(w,result);
  33.   if length(result) = 1 then
  34.     tf := '0'+result
  35.   else
  36.     tf := result;
  37. end;
  38.  
  39. procedure print_src_files;
  40. const
  41.   monthname : array[1..12] of string[9] = ('January','February',
  42.                                             'March','April','May',
  43.                                             'June','July','August',
  44.                                             'September','October',
  45.                                             'November','December');
  46. var
  47.   thisfile : src_file_ptr;
  48.   ofs : word;
  49.   dt : datetime;
  50. begin
  51.   writeln;
  52.   writeln('Source File Records');
  53.   ofs := header^.ofs_src_name;
  54.   while ofs < header^.ofs_line_lengths do
  55.   begin
  56.     thisfile := add_offset(buffer,ofs);
  57.     with thisfile^ do
  58.     begin
  59.       case filetype of
  60.       3 : write('Includes ');
  61.       4 : write('Main src ');
  62.       5 : write('Links to ');
  63.       else
  64.           write('Unknown file type ',filetype,' ');
  65.       end;
  66.       write(filename);
  67.       if packed_date <> 0 then
  68.       begin
  69.         unpacktime(packed_date,dt);
  70.         with dt do
  71.           write(' ':(15-length(filename)),tf(hour),':',tf(min),':',tf(sec),' ',monthname[month],' ',day,', ',year);
  72.       end;
  73.       if w1 <> 0 then
  74.         write(' w1 = ',w1);
  75.       writeln;
  76.       inc(ofs,sizeof(src_file_rec)-255+length(filename));
  77.     end;
  78.   end;
  79. end;
  80.  
  81. procedure print_src_lines;
  82. var
  83.   ofs : word;
  84.   line,i,codeofs : word;
  85.   thisrec : src_line_ptr;
  86.   obj : obj_ptr;
  87.   bytes_per_line : byte_array_ptr;
  88.   name : string;
  89.   src_file : src_file_ptr;
  90.   column : byte;
  91. begin
  92.   writeln;
  93.   writeln('Source Line Numbers');
  94.   writeln;
  95.   column := 1;
  96.   ofs := header^.ofs_line_lengths;
  97.   if ofs = header^.sym_size then
  98.     writeln('(none)')
  99.   else
  100.     while ofs < header^.sym_size do
  101.     begin
  102.       thisrec := add_offset(buffer,ofs);
  103.       with thisrec^ do
  104.       begin
  105.         if owner_ofs <> 0 then
  106.         begin
  107.           obj := add_offset(buffer,owner_ofs);
  108.           name := obj^.name;
  109.         end
  110.         else
  111.           name := 'initialization code';
  112.         src_file := add_offset(buffer,header^.ofs_src_name+src_ofs);
  113.         writeln('Line number offsets for ',name,' in ',src_file^.filename);
  114.         bytes_per_line := add_offset(thisrec,sizeof(src_line_rec));
  115.         line := 0;
  116.         i := 0;
  117.         column := 0;
  118.         codeofs := entry;
  119.         while line < numlines do
  120.         begin
  121.           if bytes_per_line^[i] > 0 then
  122.           begin
  123.             write(startline+line:6,':',hexword(codeofs):4);
  124.             inc(column);
  125.             if column = 7 then
  126.             begin
  127.               column := 0;
  128.               writeln;
  129.             end;
  130.             if bytes_per_line^[i] >= $80 then
  131.             begin
  132.               inc(codeofs,$100*(bytes_per_line^[i]-$80)
  133.                                +bytes_per_line^[i+1]);
  134.               inc(i);
  135.             end
  136.             else
  137.               inc(codeofs,bytes_per_line^[i]);
  138.           end;
  139.           inc(line);
  140.           inc(i);
  141.         end;
  142.         inc(ofs,sizeof(thisrec^)+i);
  143.       end;
  144.       if column <> 0 then
  145.         writeln;
  146.     end;
  147. end;
  148.  
  149. end.
  150.